'++LotusScript Development Environment:2:5:(Options):0:74
Option Public


'++LotusScript Development Environment:2:5:(Forward):0:1
Declare Sub CallGNN
Declare Function ReplaceStr (S As String, O As String, R As String) As String
Declare Sub Initialize
Declare Sub ParseNetscapeBookmark

'++LotusScript Development Environment:2:5:(Declarations):0:10
Declare Public Function GetPrivateProfileString Lib"Kernel" (Byval lpName As String, Byval lpKey As Any, Byval lpDefault As String, Byval lpReturn As String, Byval nSize As Integer, Byval lpFile As String) As Integer
Declare Public Function RegOpenKeyExA Lib "advapi32" Alias "RegOpenKeyExA" (Byval HKEY As Long,Byval lpszSubKey As String,Byval dwreserved As Integer,Byval samDesired As Long, keyresult As Long) As Long
Declare Public Function RegQueryValueExA Lib "advapi32" Alias "RegQueryValueExA" (Byval HKEY As Long,Byval lpszValueName As String,Byval dwreserved As Integer, lpdwtype As Long, Byval lpData As String, readbytes As Long) As Long
Declare Public Function RegCloseKey Lib "advapi32" Alias "RegCloseKey" (Byval HKEY As Long) As Long
Declare Public Function GetPrivateProfileStringA Lib "kernel32" Alias "GetPrivateProfileStringA"(Byval AppName As String,Byval KName As Any, Byval Def As String, Byval RStr As String, Byval nSize As Integer, Byval FName As String) As Integer

Dim strURL As String
Dim strPageTitle As String

Dim iMoreInfo As Integer   'Tracks 'more info' on the Found Set Report

'++LotusScript Development Environment:2:2:CallGNN:1:8
Sub CallGNN
	
	
	Dim happkey As Long
	Dim HKEY_LOCAL_MACHINE As Long
	Dim KEY_READ As Long
	Dim HKEY_CURRENT_USER As Long
	Dim HKEY_CLASSES_ROOT As Long
	Dim ValueType As Long
	Dim ReturnedKeyContents As String * 255
	Dim readbytes As Long
	Dim ReturnString As String * 255
	MaxBytes%=Len(ReturnString$)
	IniFileName$ = "Win.Ini"
	ReturnedKeycontents$=String$(255,Chr$(32))
	
	HKEY_CLASSES_ROOT= &H80000000
	HKEY_CURRENT_USER= &H80000001
	HKEY_LOCAL_MACHINE= &H80000002
	
	KEY_QUERY_VALUE=1
	KEY_ENUMERATE_SUBKEYS=8
	KEY_NOTIFY=16
	KEY_READ=KEY_QUERY_VALUE Or KEY_ENUMERATE_SUBKEYS Or KEY_NOTIFY
	
	KeyName$="http\shell\open\command"
	URL$= "http://"+currentview.body.url.text
	
	GNNStat = GetPrivateProfileStringA("GNNWorks","AppPath","NA",ReturnString$,MaxBytes%,IniFileName$)
	AppPath$=Left$(ReturnString$,GNNStat)
	
	If AppPath$="NA" Then ' did not find 16 bit GNN works
		ValueName$=""
		lstat=RegOpenKeyExA(HKEY_CLASSES_ROOT,KeyName$,0,KEY_READ,happkey)
		ReadBytes=255
		lstat=RegQueryValueExA(happkey,ValueName$,0,valueType, ReturnedKeyContents$,ReadBytes)
		regclosekey(happkey)
		If Trim$(ReturnedKeyContents$)="" Then
			Messagebox("Approach can't determine if a WWW browser is installed, script aborted.")
			Exit Sub
		End If
		BrowserPath$=Left$(ReturnedKeyContents$,ReadBytes-1)
		
        ' delete all command line params:
		ExePos=Instr(BrowserPath$,".exe")
		If ExePos<>0 Then
			BrowserPath$=Left$(BrowserPath$,ExePos+4)
		End If
		
		' return path without leading quote, if there is one:
		QuotePos=Instr(BrowserPath$,Chr$(34))
		If QuotePos<>0 Then
			BrowserPath$=Mid$(BrowserPath$,QuotePos+1)
		End If
	Else
		' found GNN Works
		BrowserPath$ = Left(AppPath$,GNNStat) & "\IW.EXE"
	End If
	
	LaunchPath$=BrowserPath$+" "+URL$
	Err=0
	On Error Resume Next
	stat = Shell(LaunchPath$, 1)
	On Error Goto 0
	If Err<>0 Then
		Messagebox "Error launching web browser, please check installation and try again.", MB_OK, "Error"
	End If 
End Sub
'++LotusScript Development Environment:2:1:ReplaceStr:1:8
Function ReplaceStr (S As String, O As String, R As String) As String
' S is the input string, O is the old string, R is the replacement string
	If (S = "") Then
		ReplaceStr = ""
	Else
		n = Instr(S,O)
		While (n > 0)
			Mid(S,n) = R
			n = Instr(S,O)	
		Wend
		ReplaceStr = S
	End If
End Function
'++LotusScript Development Environment:2:2:Initialize:1:10
Sub Initialize
	iMoreInfo = False
End Sub
'++LotusScript Development Environment:2:2:ParseNetscapeBookmark:1:8
Sub ParseNetscapeBookmark
	'Declarations
	Dim strNetPath As String
	Dim strBookmarkFile As String
	Dim strBookmarks As String
	Dim strType As String	
	Dim strCrntHdr As String
	Dim strSurfnet As String
	Dim strTableName As String
	Dim strCrntURL As String
	Dim strCrntBkmrk As String
	Dim strMsg As String   'Messag for message box.
	
	Dim iFileId As Integer
	Dim rval As Integer   'Return value.
	   'Flag (0=quit, 1=quit, 2=go)
	Dim iOK As Integer
	
	Dim lFileLen As Long
	
	Dim Con As New Connection
	Dim Qry As New Query
	Dim RS As New ResultSet
	
	'Array of bookmarks (Title, URL, Category)
	Dim aryBookmarks(10, 10, 10) As String
	
	'Initializations
	iOK = 0
	strMsg = "Incorrect directory or file doesn't exist, try again?"
	On Error Resume Next   'If error occurs, continue.
	
	Do Until (iOK <> 0)
		strNetPath = Inputbox("Enter the name of the Netscape directory.", "Netscape Directory", "C:\NETSCAPE", 150, 150)
		strBookmarkFile = strNetPath & "\BOOKMARK.HTM"
		strTemp = Dir(strBookmarkFile)  'List the file.
		If (strTemp = "") Then   'If the file doesn't exist...
			rval = 1   'Reset
			rval = Messagebox(strMsg , 1,  "Warning")
			If (rval = 1) Then
				iOK = 0
			Else
				iOK = 1
			End If
		Else
			iOK = 2
		End If
	Loop
	
	If (iOK = 2) Then
		lFileLen = Filelen(strBookmarkFile)
		iFileId = 1
		'Open the file.
		Open strBookmarkFile For Input Access Read As iFileId Len = lFileLen
		
		strType = "N"
		strTableName = CurrentDocument.Tables(0).FileName
		strSurfnet = CurrentDocument.Path & strTableName
		
		'Use the data object to enter records.
		If (Con.ConnectTo("dBASE IV")) Then
			Set Qry.Connection = Con
			Qry.Tablename = strSurfnet
			Set RS.Query = Qry
			If (RS.Execute = False) Then
				Messagebox "Couldn't access file for import."
			End If
		Else
			Messagebox "Couldn't access file for import."
		End If
		
		'Put the contents of the file in a variable.
		strBookmarks = Input$(lFileLen, iFileId)
		For i = 1 To lFileLen
			'Reset the header if the bookmark has none.
			If (Mid$(strBookmarks, i, 8) = "</DL><p>") Then
				strCrntHdr = ""
			End If
			
			'Find the header.
			If (Mid$(strBookmarks, i, 3) = "<H3") Then
				'We've found a header.
				strCrntHdr = ""
				'Now let's find the header name
				Do Until (Mid$(strBookmarks, i, 1) = ">")
					i = i + 1
				Loop
				i = i+ 1   'Get next character.
				'Get the header and put in a variable.
				strCrntHdr = ""   'Reset variable.
				Do Until (Mid$(strBookmarks, i, 1) = "<")
					strCrntHdr = strCrntHdr & Mid$(strBookmarks, i, 1)
					i = i+ 1
				Loop
				
			'Find the bookmark
			Elseif (Mid$(strBookmarks, i, 2) = "<A") Then
			'We've found a bookmark
				strType = "B"
			'Now let's find the URL
				Do Until (Mid$(strBookmarks, i, 1) = """")
					i = i + 1
				Loop
				i = i+ 1   'Get next character.
				
			'Get the URL and put in a variable.
				Do Until (Mid$(strBookmarks, i, 1) = """")
					strCrntURL = strCrntURL & Mid$(strBookmarks, i, 1)
					i = i+ 1
				Loop
				
        		'delete all http;// prefix
				Dim HTTPPos As Integer
				HTTPPos = Instr(strCrntURL, "http://")
				If HTTPPos <> 0 Then
					strCrntURL = Right$(strCrntURL, Len(strCrntURL) - 7)
				End If
				
				
			'Now let's find the bookmark name.
				Do Until (Mid$(strBookmarks, i, 1) = ">")
					i = i + 1
				Loop
				i = i+ 1   'Get next character.
			'Get the bookmark name  and put in a variable.
				Do Until (Mid$(strBookmarks, i, 1) = "<")
					strCrntBkmrk = strCrntBkmrk & Mid$(strBookmarks, i, 1)
					i = i+ 1
				Loop
				
				If (Mid$(strBookmarks, i, 4) = "</A>") Then
					'Now let's add the record to the file.
					RS.AddRow
					rval = RS.SetValue(2, strCrntBkmrk)
					rval = RS.SetValue(1, strCrntURL)
					rval = RS.SetValue(3, strCrntHdr)
					RS.UpdateRow
					strCrntURL = ""
					strCrntBkmrk = ""
				End If
			End If
		Next
		Close(1)
		RS.Close
		Messagebox "Import complete.", MB_OK, "Import"
	End If
	
EndImport:
End Sub